home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gambler 19
/
GAMBLERCD19.BIN
/
UTILS
/
RIVA128
/
Uzytki
/
IdGamma v1.2 beta
/
IDGAMMA.BAS
< prev
next >
Wrap
BASIC Source File
|
1998-05-16
|
16KB
|
700 lines
DECLARE SUB GetCommandSettings ()
DECLARE SUB AdjPalette ()
DECLARE SUB CheckSettings ()
DECLARE SUB DoConfig ()
DECLARE SUB FindPak ()
DECLARE SUB GetAnswer ()
DECLARE SUB GetBatSettings ()
DECLARE SUB GetIdealSettings ()
DECLARE SUB GetInputs ()
DECLARE SUB GetOffsets ()
DECLARE SUB GetPalette ()
DECLARE SUB GetQ2Intensity ()
DECLARE SUB Getsettings ()
DECLARE SUB InitScreen ()
DECLARE SUB MakePak ()
DECLARE SUB PutPalette ()
DECLARE SUB PutQ2intensity ()
DEFDBL A-Z
CONST Quake1 = 1, Quake2 = 2, Hexen2 = 3, True = -1, False = 0
CONST infile = "IDGAMMA.DAT"
CONST Yes = 89, No = 78
CONST Version = "Idgamma Version 1.2"
DIM colors(0 TO 63, 0 TO 255) AS INTEGER
DIM palet(0 TO 255, 1 TO 3) AS INTEGER
COMMON SHARED Intensity, fullbright, Game, AllowSat, Gamma, Q2Intensity, Glmodulate
COMMON SHARED StartFile, StartPalette, Bytes, OutPalette, ini AS STRING
COMMON SHARED p AS STRING * 768, colors() AS INTEGER, palet() AS INTEGER
COMMON SHARED endtable, ch AS STRING * 1, OutFile AS STRING * 8, NoUI AS INTEGER
COMMON SHARED Question$, answer AS INTEGER, Description$
COMMON SHARED FoundPak AS INTEGER
OutFile = "PAK?.PAK"
IF LEN(DIR$(OutFile)) OR LEN(DIR$("CONFIG.CFG")) THEN
GetInputs
IF Game = Quake2 THEN
IF Q2Intensity > 0 THEN PutQ2intensity
DoConfig
END IF
GetOffsets 'get offsets in idgamma.dat
FindPak
IF NOT FoundPak THEN MakePak
GetPalette
AdjPalette
PutPalette
'AdjColorTable
'PutColorTable
ELSE
InitScreen
PRINT "Cannot find any PAK files"
PRINT "This Program must be run from the same"
PRINT "directory as your PAK files or config.cfg"
PRINT "Example directories are ID1, BASEQ2 or DATA1"
END IF
SYSTEM
SUB AdjColorTable
'make color table
LOCATE 10, 1: PRINT "Processing light level: % complete";
FOR h = 0 TO 63
LOCATE 10, 24: PRINT INT(1.587302 * h)
IF h = 32 THEN
FOR I = 0 TO 255
colors(h, I) = I
colors(h, I) = 15
NEXT I
ELSE
FOR I = 1 TO 255
r = palet(I, 1)
g = palet(I, 2)
b = palet(I, 3)
total = r + g + b
r = r * (64 - h) / 32
g = g * (64 - h) / 32
b = b * (64 - h) / 32
IF r >= b AND r >= g THEN d = r / 255
IF g >= r AND g >= b THEN d = g / 255
IF b >= r AND r >= g THEN d = b / 255
IF d > 1 THEN
r = r / d
g = g / d
b = b / d
' r = (r + r / d) / 2
' g = (g + g / d) / 2
' b = (b + b / d) / 2
END IF
min = 9999
FOR j = 0 TO 255
r1 = palet(j, 1)
g1 = palet(j, 2)
b1 = palet(j, 3)
'IF total <= palet(j, 0) THEN
dr = ((r1 - r) ^ 2 + (g1 - g) ^ 2 + (b1 - b) ^ 2) ^ .5
IF dr < min THEN
min = dr
colors(h, I) = j
' IF min < 1 THEN EXIT FOR
END IF
'END IF
NEXT j
NEXT I
END IF
NEXT h
END SUB
SUB AdjPalette
'Changes the colors for brighter ones
ax = (255 * 3) / (2 + Intensity)
' ax = 0
M = 1
IF Intensity <> 1 THEN M = (255 - ax) / (255 - ax / (Intensity))
Bx = 255 * (1 - M)
offset = (255 - (255 * Gamma)) / (3 * Intensity)
r0 = palet(8, 1) * Intensity
FOR I = 0 TO 255
r = palet(I, 1)
g = palet(I, 2)
b = palet(I, 3)
IF I < fullbright OR (Game = 2 AND I > 239) THEN
IF Game <> Quake2 THEN
r = r + offset
g = g + offset
b = b + offset
END IF
Max = r
IF g > Max THEN Max = g
IF b > Max THEN Max = b
Mult = Intensity
Max = Intensity * Max
SELECT CASE AllowSat
CASE IS < 3
IF AllowSat = 1 AND I > 8 AND I < 16 THEN
r = r0 + (I - 8) * (255 - r) / (255 - r0)
b = r
g = r
Mult = 1
ELSE
IF Max > 255 THEN
Mult = Intensity * 255 / Max
IF AllowSat = 2 THEN
r = r * Mult + ((255 - r * Mult) / (Intensity))
g = g * Mult + ((255 - g * Mult) / (Intensity))
b = b * Mult + ((255 - b * Mult) / (Intensity))
Mult = 1
END IF
END IF
END IF
CASE IS = 3 AND Max > ax
IF AllowSat = 2 THEN
IF Max > 255 THEN
Mult = Mult * (255 + Max + Max) / (Max + Max + Max)
END IF
END IF
END SELECT
r = r * Mult
g = g * Mult
b = b * Mult
IF r < 0 THEN r = 0
IF g < 0 THEN g = 0
IF b < 0 THEN b = 0
IF r > 255 THEN r = 255
IF g > 255 THEN g = 255
IF b > 255 THEN b = 255
END IF
palet(I, 1) = r
palet(I, 2) = g
palet(I, 3) = b
NEXT
END SUB
SUB CheckSettings
InitScreen
PRINT Description$
PRINT
x$ = "(Quake 1)"
IF Game = Quake2 THEN x$ = "(Quake 2)"
IF Game = Hexen2 THEN x$ = "(Hexen 2)"
PRINT " Game ="; Game; x$
IF Game = Quake2 THEN
PRINT " Ref_gl Intensity =";
IF Q2Intensity = 0 THEN
PRINT " (Leave Ref_gl.dll Alone)"
ELSE
PRINT Q2Intensity
END IF
END IF
PRINT " gl_modulate ="; Glmodulate
PRINT " Intensity ="; Intensity
PRINT " Gamma ="; Gamma
SELECT CASE AllowSat
CASE 1
x$ = "No"
CASE 2
x$ = "Little"
CASE 3
x$ = "Some"
CASE ELSE
x$ = ""
END SELECT
PRINT " Allowsat ="; AllowSat; "(Allow " + x$ + " Saturation)"
PRINT " fullbright = ";
IF fullbright = 0 THEN
PRINT "Y (Leave Fullbrights Alone)"
ELSE
PRINT "N (Don't Leave Fullbrights Alone)"
END IF
PRINT
Question$ = "Use these Values? (Y/N)"
GetAnswer
END SUB
SUB DoConfig
filenum = FREEFILE
ch = CHR$(13)
a$ = "CONFIG"
GOSUB DoA
a$ = "AUTOEXEC"
GOSUB DoA
PRINT
PRINT "CONFIG.CFG and AUTOEXEC.CFG updated."
PRINT
EXIT SUB
DoA:
f1$ = a$ + ".IDG"
f2$ = a$ + ".CFG"
SHELL "attrib -h -s -r " + f2$
SHELL "copy " + f2$ + " " + f1$ + ">nul"
OPEN f1$ FOR INPUT AS filenum
OPEN f2$ FOR OUTPUT AS filenum + 1
DO WHILE NOT EOF(filenum)
LINE INPUT #filenum, x$
y$ = UCASE$(LTRIM$(RTRIM$(x$)))
aa = 0
IF LEN(x$) THEN
IF INSTR(y$, "BIND") <> 1 AND MID$(y$, 1, 2) <> "//" THEN
aa = (INSTR(y$, "INTENSITY") OR INSTR(y$, "VID_GAMMA"))
aa = aa OR (Glmodulate AND (INSTR(y$, "GL_MODULATE")))
END IF
END IF
IF aa = 0 THEN
PRINT #(filenum + 1), x$
END IF
LOOP
IF a$ = "CONFIG" THEN
PRINT #(filenum + 1), "set vid_gamma"; Gamma
IF Glmodulate THEN PRINT #(filenum + 1), "set gl_modulate"; Glmodulate
END IF
CLOSE filenum
CLOSE filenum + 1
RETURN
END SUB
SUB FindPak
c = 49 '"1"
FoundPak = False
DO
MID$(OutFile, 4, 1) = CHR$(c)
x$ = DIR$(OutFile)
IF LEN(x$) > 0 THEN
OPEN OutFile FOR BINARY AS 1
length = LOF(1)
CLOSE 1
IF length = Bytes THEN FoundPak = True
END IF
c = c + 1
LOOP UNTIL LEN(x$) = 0 OR FoundPak = True
END SUB
SUB GetAnswer
answer = 0
COLOR 15, 1
DO
PRINT Question$;
COLOR 14, 1
INPUT y$
PRINT
IF LEN(y$) THEN answer = ASC(UCASE$(RTRIM$(LTRIM$(y$))))
LOOP UNTIL answer = Yes OR answer = No
END SUB
SUB GetcolorTable
CONST colormap = "COLORMAP.LMP"
' IF DIR$(colormap) <> colormap THEN
OPEN "COLORMAP.PCX" FOR BINARY AS 1
x$ = ""
I = 129
DO
GET #1, I, ch
IF ch = "┴" THEN
I = I + 1
GET #1, I, ch
END IF
x$ = x$ + ch
I = I + 1
LOOP UNTIL LEN(x$) = 16385
OPEN colormap FOR OUTPUT AS #2
PRINT #2, x$;
CLOSE
endtable = I
' END IF
END SUB
SUB GetCommandSettings
ini = COMMAND$
IF LEN(ini) THEN
filenum = FREEFILE
Description$ = ini
ch = MID$(ini, 1, 1)
IF ch = "#" OR ch = "[" THEN
IF ch = "#" THEN
NoUI = True
Description$ = MID$(ini, 2)
END IF
ini = "IDGAMMA.INI"
OPEN ini FOR OUTPUT AS filenum
PRINT #filenum, Description$
CLOSE #filenum
END IF
IF DIR$(ini) <> ini THEN PRINT ini; " not found": SYSTEM
OPEN ini FOR INPUT AS filenum
INPUT #filenum, Description$, Game, Q2Intensity, Glmodulate, Intensity, Gamma, AllowSat, fullbright
CLOSE filenum
END IF
END SUB
SUB GetIdealSettings
fullbright = 1
Description$ = "Default Ideal Settings"
IF Game = Quake2 THEN
Q2Intensity = 1
Glmodulate = 2
Intensity = VAL("2")
Gamma = VAL(".8")
AllowSat = 1
ELSE
Intensity = VAL("1.5")
Gamma = VAL(".95")
AllowSat = 3
END IF
END SUB
SUB GetInputs
IF DIR$(infile) = infile THEN
OPEN infile FOR BINARY AS #1
Q2Intensity = False
GET #1, 98695, Game
GET #1, , Q2Intensity
GET #1, , Glmodulate
GET #1, , Intensity
GET #1, , Gamma
GET #1, , AllowSat
GET #1, , fullbright
NoUI = False
GetCommandSettings
IF NoUI = False THEN
DO
CheckSettings
IF answer = Yes THEN EXIT DO
InitScreen
DO
PRINT "Enter Game, (Quake1=1, Quake2=2, Hexen2=3)"
COLOR 15, 1
PRINT "Game"; Game;
COLOR 14, 1
INPUT offset
LOOP UNTIL offset > -1 AND offset < 4
IF offset THEN Game = CINT(offset)
PRINT
Question$ = "Use Preselected Ideal Settings? (Y/N)"
GetAnswer
IF answer = Yes THEN
GetIdealSettings
ELSE
Getsettings
END IF
LOOP
END IF
PUT #1, 98695, Game
PUT #1, , Q2Intensity
PUT #1, , Glmodulate
PUT #1, , Intensity
PUT #1, , Gamma
PUT #1, , AllowSat
PUT #1, , fullbright
CLOSE
ELSE
PRINT "Cannot find IDgamma.dat": SYSTEM
END IF
IF fullbright = 0 THEN
IF Game = Quake1 THEN fullbright = 224
IF Game = Quake2 THEN fullbright = 208
IF Game = Hexen2 THEN fullbright = 240
ELSE
fullbright = 257
END IF
Getinput:
END SUB
SUB GetOffsets
'get offsets in idgamma.dat
IF Game = Quake2 THEN
Bytes = 97004
StartPalette = 96940
StartFile = 769
OutPalette = 96172
ELSE
Bytes = 844
StartFile = 97773
StartPalette = 97785
OutPalette = 13
IF Game = Quake1 THEN StartPalette = 1
END IF
END SUB
SUB GetPalette
OPEN infile FOR BINARY AS 1
GET #1, StartPalette, p
CLOSE
I = 0
k = 0
DO
FOR j = 1 TO 3
palet(I, j) = ASC(MID$(p, k + j, 1))
NEXT
I = I + 1
k = k + 3
LOOP UNTIL I >= 255
END SUB
SUB GetQ2Intensity
DIM x AS STRING * 5
Q2Intensity = 0
IF LEN(DIR$("..\REF_GL.DLL")) THEN
filenum = FREEFILE
OPEN "..\REF_GL.DLL" FOR BINARY ACCESS READ AS filenum
GET filenum, 160165, x
CLOSE filenum
IF x = "inten" THEN
PRINT
PRINT "Enter Quake2 Default intensity (See Idgamma.txt for details)"
PRINT "Recommend Default intensity set to 1"
PRINT "Press enter to leave REF_GL.DLL alone"
COLOR 15, 1
PRINT "Default Intensity";
COLOR 14, 1
INPUT offset
IF offset THEN
IF offset < 0 OR offset > 10 THEN offset = 1
Q2Intensity = CINT(offset * 10) / 10
END IF
ELSE
PRINT "REF_GL.DLL corrupt or wrong version"
END IF
ELSE
PRINT "Cannot find REF_GL.DLL"
END IF
END SUB
SUB Getsettings
IF Game = Quake2 THEN
GetQ2Intensity
PRINT
PRINT "Enter gl_modulate, (1 = original, 2.5 is brighter)"
COLOR 15, 1
PRINT "glmodulate"; Glmodulate;
COLOR 14, 1
INPUT offset
IF offset THEN
Glmodulate = offset
END IF
END IF
PRINT
PRINT "Enter Intensity, (1 = original, 2.5 is brighter)"
COLOR 15, 1
PRINT "Intensity"; Intensity;
COLOR 14, 1
INPUT offset
IF offset THEN Intensity = offset
PRINT
PRINT "Enter Gamma, (1 = original, .8 is lighter)"
PRINT "for quake2 use console vid_gamma instead"
COLOR 15, 1
PRINT "Gamma"; Gamma;
COLOR 14, 1
INPUT offset
IF offset THEN Gamma = offset
PRINT
PRINT
PRINT "Saturation is when brighter colors are replaced with white."
PRINT " / 1 = No Saturation 3 = Some Saturation \"
PRINT " \ 2 = Little Saturation 4 = Allow Saturation /"
COLOR 15, 1
PRINT "Allow Saturation"; AllowSat;
COLOR 14, 1
INPUT offset
IF offset THEN AllowSat = offset
PRINT
IF fullbright = 0 THEN x$ = "y)" ELSE x$ = "n)"
PRINT "Some Fullbrights are used for explosions and fire"
COLOR 15, 1
PRINT "Leave fullbrights Alone? (y/n) ("; x$;
COLOR 14, 1
INPUT x$
IF LEN(x$) > 0 AND Game < 4 THEN
IF LCASE$(MID$(x$, 1, 1)) = "y" THEN
fullbright = 0
ELSE
fullbright = 1
END IF
END IF
END SUB
SUB InitScreen
COLOR 15, 1: CLS
PRINT Version: PRINT
COLOR 14, 1
END SUB
SUB MakePak
DIM hdr AS STRING * 128
OPEN infile FOR BINARY AS 1
OPEN OutFile FOR OUTPUT AS 2
SEEK #1, StartFile
loops = Bytes \ 8192
IF loops THEN
x$ = SPACE$(8192)
DO WHILE loops
GET #1, , x$
loops = loops - 1
PRINT #2, x$;
LOOP
END IF
rest = Bytes - SEEK(2) + 1
IF rest THEN
x$ = SPACE$(rest)
GET #1, , x$
PRINT #2, x$;
END IF
CLOSE
END SUB
SUB PutColorTable
FOR h = 0 TO 63
FOR I = 0 TO 255
x$ = x$ + CHR$(colors(h, I))
NEXT I
NEXT h
OPEN "gfx\colormap.lmp" FOR OUTPUT AS #1
PRINT #1, x$;
CLOSE
END SUB
SUB PutPalette
I = 0
k = 0
DO
FOR j = 1 TO 3
MID$(p, j + k, 1) = CHR$(palet(I, j))
NEXT
I = I + 1
k = k + 3
LOOP UNTIL I >= 255
OPEN OutFile FOR BINARY AS 1
PUT #1, OutPalette, p
CLOSE
PRINT OutFile; " created."
END SUB
SUB PutQ2intensity
filenum = FREEFILE
OPEN "..\REF_GL.DLL" FOR BINARY AS filenum
ch = CHR$(0)
y$ = STR$(Q2Intensity)
MID$(y$, 1, 1) = ch
DO
y$ = y$ + ch
LOOP UNTIL LEN(y$) = 5
PUT filenum, 160176, y$
CLOSE filenum
END SUB